home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / SAT 2.3.7 / Add-ons / Storage / Scores.p < prev    next >
Encoding:
Text File  |  1995-09-12  |  11.6 KB  |  472 lines  |  [TEXT/PJMM]
  1. {================================================}
  2. {============= Score handling and display ==============}
  3. {================================================}
  4.  
  5. {Reusable score and highscore unit! All code that needs changing is in ScoresStubs.}
  6.  
  7. {You should call InitScores before using any other routines, and pass the refnum of your}
  8. {preference file. If you don't, it will still work, but the application file (or whatever the}
  9. {current resource file is when you call) will be used - a "best effort" soluition that may}
  10. {not be what you want.}
  11.  
  12. unit Scores;
  13.  
  14. interface
  15.     uses
  16. {$IFC UNDEFINED THINK_PASCAL}
  17.         Types, QuickDraw, Fonts, Events, Packages, Menus, Dialogs, Windows,{}
  18.         OSUtils, ToolUtils, Resources, 
  19. {$ELSEC}
  20.         InterfacesUI, 
  21. {$ENDC}
  22.         SAT, ScoresStubs;
  23.  
  24.     procedure InitScores (prefFile: Integer);                    { Loads the high score list and the high score window. }
  25.     procedure ZeroScore;                     { Call this on New Game! }
  26.     procedure DrawHighScores (bounds: Rect; rankPos, namePos, datePos, levelPos: Integer; markLatest: Boolean);
  27.     procedure EraseHighScores (ask: Boolean);
  28.     function TestNewHigh (level: Integer): Boolean;
  29.     procedure AddScore (amount: Longint);
  30.     procedure AddScoreImmediate (amount: Longint);
  31.  
  32.  
  33. implementation
  34.  
  35. { Highscore record }
  36.     type
  37.         str20 = string[kStringSize];
  38.  
  39.         HsRec = record
  40.                 highScore: array[1..kListLength] of longint;
  41.                 highPlayer: array[1..kListLength] of Str20;
  42.                 lastPlayer: Str20;
  43.                 when: array[1..kListLength] of Longint;
  44.                 level: array[1..kListLength] of Integer;
  45.             end;
  46.         HsPtr = ^HsRec;
  47.         HsHnd = ^HsPtr;
  48.  
  49.     var
  50.         hs: hsHnd;                {Handle to high scores resource, initialized by }
  51.         gLastHigh: Integer;    {Index of last high score}
  52.         scoresInitialized: Boolean;
  53.         gScore: Longint;
  54.         gPrefFile: Integer;    {Pref file}
  55.  
  56. {Standard filter function, here used for AskHigh}
  57.  
  58.     function StdFilter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
  59.         var
  60.             theChar: Char;
  61.             kind: integer;
  62.             item: Handle;
  63.             box: Rect;
  64.     begin
  65.  
  66.         if theEvent.what = updateEvt then
  67.             begin
  68.                 BeginUpdate(theDialog);
  69.                 SetPort(theDialog);
  70.  
  71.                 DrawDialog(theDialog);
  72.  
  73. {Frame button}
  74.                 GetDialogItem(theDialog, ok, kind, item, box);
  75.                 InsetRect(box, -4, -4);
  76.                 PenSize(3, 3);
  77.                 FrameRoundRect(box, 15, 15);
  78.  
  79.                 StdFilter := false;
  80.  
  81.                 EndUpdate(theDialog);
  82.             end;
  83.  
  84.         if theEvent.what = keyDown then
  85.             begin
  86.                 theChar := Char(BitAnd(theEvent.message, charCodeMask));
  87.                 if ((BitAnd(theEvent.modifiers, cmdkey) <> 0) and (theChar = '.')) or (theChar = char(27)) then {cmd-. eller ESC}
  88. {if TestDItemEnable(theDialog, cancel) then}
  89.                     begin
  90.                         itemHit := cancel;
  91. {Måste jag highlighta till keyup?}
  92.  
  93.                         GetDialogItem(theDialog, cancel, kind, item, box);
  94.                         HiliteControl(ControlHandle(item), 1);
  95.  
  96.                         StdFilter := true;
  97.                         exit(StdFilter);
  98.                     end;
  99.                 if (theChar = char(13)) or (theChar = char(3)) then
  100. {if TestDItemEnable(theDialog, ok) then}
  101.                     begin
  102.                         itemHit := ok;
  103.                         GetDialogItem(theDialog, ok, kind, item, box);
  104.                         HiliteControl(ControlHandle(item), 1);
  105.                         StdFilter := true;
  106.                         exit(StdFilter);
  107.                     end;
  108.             end;
  109.         StdFilter := false;
  110.     end; {StdFilter}
  111.  
  112. { Ask for players name (at highscore) }
  113.     function AskHigh: str255;
  114.         var
  115.             dialog: DialogPtr;
  116.             oldPort: SATPort;
  117.             itemHit: integer;
  118.             itemHandle: Handle;
  119.             itemType, item: integer;
  120.             itemRect: Rect;
  121.             str: str255;
  122.     begin
  123.         SATGetPort(oldPort);
  124.         SATSetPortScreen;
  125.         dialog := GetNewDialog(kAskHighDlog, nil, WindowPtr(-1));
  126.         ShowWindow(dialog);
  127.         SelectWindow(dialog);
  128.         if gSAT.colorFlag then
  129.             SetGDevice(GetMainDevice);
  130.         SetPort(dialog);
  131.  
  132.         GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
  133.         SetDialogItemText(itemHandle, hs^^.lastPlayer);
  134.         SelectDialogItemText(dialog, 3, 0, 32767);
  135.         itemHit := -1;
  136.         while (itemHit <> 1) and (itemHit <> 2) do { 1=ok, 2=cancel }
  137.             ModalDialog(@StdFilter, itemHit);
  138.         if itemHit = 2 then
  139.             begin
  140.                 AskHigh := '';
  141.             end;
  142.         if itemHit = 1 then
  143.             begin
  144.                 GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
  145.                 GetDialogItemText(itemHandle, str);
  146.                 if Length(str) > kStringSize then
  147.                     str[0] := Char(kStringSize);
  148.                 hs^^.lastPlayer := str;
  149.                 AskHigh := str;
  150.             end;
  151.         DisposeDialog(dialog);
  152.         SATSetPort(oldPort);
  153.     end; {AskHigh}
  154.  
  155.  
  156.     procedure DrawHighScores (bounds: Rect; rankPos, namePos, datePos, levelPos: Integer; markLatest: Boolean);
  157. {bounds: Area in which to draw. (Current port!)}
  158. {rankPos, namePos, datePos, levelPos: Right edge of each subfield.}
  159. {markLatest: Draw latest in red?}
  160. {Note: The score is always drawn to the right!}
  161.         var
  162.             rankBox, nameBox, dateBox, levelBox, scoreBox: Rect;
  163.             info: FontInfo;
  164.             spacing, spillSpacing: Integer;
  165.             saveColor: RGBColor;
  166.             saveBWcolor: Longint;
  167.             i: Integer;
  168.             dateString: Str255;
  169.  
  170.         procedure RestoreColor;
  171.         begin
  172.             if gSAT.colorFlag then
  173.                 RGBForeColor(saveColor)
  174.             else
  175.                 ForeColor(saveBWcolor);
  176.         end; {RestoreColor}
  177.  
  178.         procedure ProperColor (index: Integer);
  179.         begin
  180.             if (index = gLastHigh) and markLatest then
  181.                 ForeColor(redColor)
  182.             else
  183.                 RestoreColor;
  184.         end; {ProperColor}
  185.  
  186.         function Max (a, b: integer): Integer;
  187.         begin
  188.             if a > b then
  189.                 Max := a
  190.             else
  191.                 Max := b;
  192.         end; {Max}
  193.  
  194.         function Min (a, b: integer): Integer;
  195.         begin
  196.             if a < b then
  197.                 Min := a
  198.             else
  199.                 Min := b;
  200.         end; {Min}
  201.  
  202.         procedure DrawStringRight (str: Str255; width: Integer);
  203.         begin
  204.             Move(width - StringWidth(str), 0);
  205.             DrawString(str);
  206.         end; {DrawStringRight}
  207.  
  208.         function MyNumToString (num: Longint): Str255;
  209.             var
  210.                 str: Str255;
  211.         begin
  212.             NumToString(num, str);
  213.             MyNumToString := str;
  214.         end; {MyNumToString}
  215.  
  216.         function RectWidth (r: Rect): integer;
  217.         begin
  218.             RectWidth := r.right - r.left;
  219.         end; {RectWidth}
  220.  
  221.         function RectHeight (r: Rect): integer;
  222.         begin
  223.             RectHeight := r.bottom - r.top;
  224.         end; {RectHeight}
  225.  
  226.     begin {DrawHighScores}
  227.         if not scoresInitialized then
  228.             InitScores(CurResFile);
  229.  
  230.         rankBox := bounds;
  231.         nameBox := bounds;
  232.         dateBox := bounds;
  233.         levelBox := bounds;
  234.         scoreBox := bounds;
  235.  
  236.         rankBox.right := rankPos;
  237.         nameBox.left := rankPos;
  238.         nameBox.right := Min(datePos, levelPos);
  239.  
  240.         dateBox.right := datePos;
  241. {dateBox.left := Min(namePos, levelPos);}
  242.         levelBox.right := levelPos;
  243. {levelBox.left := Min(namePos, datePos);}
  244.  
  245.         if datePos <= levelPos then
  246.             begin
  247.                 dateBox.left := namePos;
  248.                 levelBox.left := datePos;
  249.             end
  250.         else
  251.             begin
  252.                 dateBox.left := levelPos;
  253.                 levelBox.left := namePos;
  254.             end;
  255.  
  256.         scoreBox.left := Max(datePos, levelPos);
  257.  
  258.         nameBox.left := nameBox.left + kMargin;
  259.         dateBox.left := dateBox.left + kMargin;
  260.         levelBox.left := levelBox.left + kMargin;
  261.         scoreBox.left := scoreBox.left + kMargin;
  262.  
  263.         GetFontInfo(info);
  264.         spillSpacing := (RectHeight(bounds) - (info.ascent + info.descent) * kListLength) div (kListLength);
  265.         spacing := spillSpacing + info.ascent + info.descent;
  266.         spillSpacing := spillSpacing div 2;
  267.  
  268.         if gSAT.colorFlag then
  269.             GetForeColor(saveColor)
  270.         else
  271. {$IFC UNDEFINED THINK_PASCAL}
  272.             saveBWcolor := qd.thePort^.fgColor;
  273. {$ELSEC}
  274.         saveBWcolor := thePort^.fgColor;
  275. {$ENDC}
  276.  
  277. {Draw rank}
  278.         if RectWidth(rankBox) > 0 then
  279.             for i := 1 to kListLength do
  280.                 begin
  281.                     ProperColor(i);
  282.                     ClipRect(rankBox);
  283.                     MoveTo(rankBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
  284.                     DrawStringRight(MyNumToString(i), RectWidth(rankBox));
  285.                 end;
  286.  
  287. {Draw name}
  288.         if RectWidth(nameBox) > 0 then
  289.             for i := 1 to kListLength do
  290.                 begin
  291.                     ProperColor(i);
  292.                     ClipRect(nameBox);
  293.                     MoveTo(nameBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
  294.                     DrawString(hs^^.highPlayer[i]);
  295.                 end;
  296.  
  297. {Draw date}
  298.         if RectWidth(dateBox) > 0 then
  299.             for i := 1 to kListLength do
  300.                 begin
  301.                     ProperColor(i);
  302.                     ClipRect(dateBox);
  303.                     MoveTo(dateBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
  304.                     if hs^^.when[i] <> 0 then
  305.                         IUDateString(hs^^.when[i], shortDate, dateString)
  306.                     else
  307.                         dateString := '-';
  308.                     DrawStringRight(dateString, RectWidth(dateBox));
  309.                 end;
  310.  
  311. {Draw level}
  312.         if RectWidth(levelBox) > 0 then
  313.             for i := 1 to kListLength do
  314.                 begin
  315.                     ProperColor(i);
  316.                     ClipRect(levelBox);
  317.                     MoveTo(levelBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
  318.                     DrawStringRight(MyNumToString(hs^^.level[i]), RectWidth(levelBox));
  319.                 end;
  320.  
  321. {Draw score}
  322.         if RectWidth(scoreBox) > 0 then
  323.             for i := 1 to kListLength do
  324.                 begin
  325.                     ProperColor(i);
  326.                     ClipRect(scoreBox);
  327.                     MoveTo(scoreBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
  328.                     DrawStringRight(MyNumToString(hs^^.highScore[i]), RectWidth(scoreBox));
  329.                 end;
  330.         RestoreColor;
  331. {$IFC UNDEFINED THINK_PASCAL}
  332.         ClipRect(qd.thePort^.portRect); {Set to a reasonable cliprect!}
  333. {$ELSEC}
  334.         ClipRect(thePort^.portRect); {Set to a reasonable cliprect!}
  335. {$ENDC}
  336.     end; {DrawHighScores}
  337.  
  338. { Call this on game over! }
  339.     function TestNewHigh (level: Integer): Boolean;
  340.         var
  341.             num, len: integer;
  342.             name, s: str255;
  343.     begin
  344.         if not scoresInitialized then
  345.             InitScores(CurResFile);
  346.  
  347.         TestNewHigh := false;
  348.         gLastHigh := 0;
  349.         if gScore > hs^^.highScore[kListLength] then
  350.             begin
  351.                 num := kListLength;
  352.                 name := AskHigh;
  353.                 if name = '' then { alt length(name) = 0 }
  354.                     Exit(TestNewHigh);
  355.  
  356.                 TestNewHigh := true;
  357.  
  358.                 if length(name) > kStringSize then
  359.                     name := copy(name, 1, kStringSize);
  360.  
  361.                 while (hs^^.highScore[num - 1] < gScore) and (num > 1) do
  362.                     begin
  363.                         hs^^.highScore[num] := hs^^.highScore[num - 1];
  364.                         hs^^.highPlayer[num] := hs^^.highPlayer[num - 1];
  365.                         hs^^.level[num] := hs^^.level[num - 1];
  366.                         hs^^.when[num] := hs^^.when[num - 1];
  367.                         num := num - 1;
  368.                     end;
  369.                 gLastHigh := num; {Remember last high for the highscore display}
  370.                 hs^^.highScore[num] := gScore;
  371.                 hs^^.highPlayer[num] := name;
  372.                 hs^^.level[num] := level;
  373.                 GetDateTime(hs^^.when[num]);
  374.                 ChangedResource(Handle(hs));
  375.             end;
  376.     end; {TestNewHigh}
  377.  
  378.  
  379.     procedure ZeroScore;
  380.     begin
  381.         if not scoresInitialized then
  382.             InitScores(CurResFile);
  383.  
  384.         gScore := 0;
  385.         gLastHigh := -1;
  386.         gNextLimit := kFirstLimit; {Nästa gräns för nytt liv!}
  387.     end;
  388.  
  389.     procedure EraseHighScores (ask: Boolean);
  390.         var
  391.             doIt: Boolean;
  392.             i: Integer;
  393.     begin
  394.         if not scoresInitialized then
  395.             InitScores(CurResFile);
  396.  
  397.         if ask then
  398.             doIt := SATQuestionStr('Are you sure you want to erase the high scores?')
  399.         else
  400.             doIt := true;
  401.         if doIt then
  402.             begin
  403.                 for i := 1 to kListLength do
  404.                     begin
  405.                         hs^^.highScore[i] := 0;
  406.                         hs^^.highPlayer[i] := 'Noone';
  407.                         hs^^.level[i] := 0;
  408.                         hs^^.when[i] := 0;
  409.                     end;
  410.                 ChangedResource(handle(hs));
  411.                 gLastHigh := -1;
  412.             end;
  413.     end; {EraseHighScores}
  414.  
  415.     procedure InitScores (prefFile: Integer);
  416.         var
  417.             saveResFile: Integer;
  418.     begin
  419.         gPrefFile := prefFile;
  420.         saveResFile := CurResFile;
  421.         UseResFile(prefFile);
  422.  
  423.         scoresInitialized := true;
  424.  
  425.         gLastHigh := -1; {no "last"}
  426.  
  427.         hs := hsHnd(GetResource('Bäst', 0));        {"Bäst" is "best" in swedish, in case you wonder…}
  428.         if hs = nil then
  429.             begin
  430.                 hs := hsHnd(NewHandle(Sizeof(hsRec)));
  431.                 CheckNoMem(Ptr(hs));
  432.                 EraseHighScores(false);
  433.                 AddResource(handle(hs), 'Bäst', 0, 'High scores');
  434.             end
  435.         else if GetHandleSize(Handle(hs)) < sizeof(hsRec) then
  436.             SetHandleSize(Handle(hs), sizeof(hsRec));
  437.  
  438.         ZeroScore;
  439.  
  440.         UseResFile(saveResFile);
  441.     end; {InitScores}
  442.  
  443.  
  444.     procedure AddScore (amount: Longint);
  445.     begin
  446.         if not scoresInitialized then
  447.             InitScores(CurResFile);
  448.  
  449.         gScore := gScore + amount;
  450.  
  451.         if gNextLimit > 0 then
  452.             if gScore >= gNextLimit then
  453.                 DoLimit;
  454.  
  455.         DrawScore(gScore);
  456.     end;
  457.  
  458.     procedure AddScoreImmediate (amount: Longint);
  459.     begin
  460.         if not scoresInitialized then
  461.             InitScores(CurResFile);
  462.  
  463.         gScore := gScore + amount;
  464.  
  465.         if gNextLimit > 0 then
  466.             if gScore >= gNextLimit then
  467.                 DoLimit;
  468.  
  469.         DrawScoreImmediate(gScore);
  470.     end;
  471.  
  472. end.